
\ Local Variables for TurboForth Version 1.1
\ 19th August 2015. Mark Wills.

\ Enhanced over the previous version as follows:
\   * Produces smaller compiled code
\   * Faster execution of code due to the use of assembly language
\     for speed critical/often used portions of the code.

\ Enhancements in this version:
\  * freeLocals and (freeLocals) removed. Allocation and de-allocation of
\    locals is consolidated into the single word (allotLocals)
\  * The parameter to (freeLocals) is now passed in-line in the code,
\    rather than via the stack. Makes for shorter compiled code (no call to
\    LIT required).
\  * (freeLocals) replaced with assembly language code for faster execution.
\  * The parameter to @local is now placed in-line with the compiled code,
\    meaning no call to LIT is required. Faster and results in smaller 
\    colon definitions.
\  * @local replaced with an assembly language routine.
\  * doSET modified to compile the offset parameter in-line with calls to (SET)
\    and (+SET) rather than as a literal via the stack. Smaller compiled code.
\  * (SET) and (+SET) modified to get the offset parameter in-line rather than 
\    via the stack. 
\  * (SET) and (+SET) replaced with assembly language routines. Much faster.
\  * To facilitate all of the above, _LS has been changed from a VALUE to above
\    variable. 


\ An implementation of local variables.
\ Not ANS compatible.
\ Local variables are declared with the word LOCALS{ followed by a list
\ of variable names, followed by a closing }
\ For example:
\   TEST ( -- ) locals{ a b c } ... ... ... ;
\ The local variables are initialised to 0 upon creation.
\
\ Locals are referenced in code with their names.
\ Locals may be written to with SET and +SET. E.g.
\ : TEST ( x y z -- ) locals{ a b c } set c   set b   set a ;
\ The above example initialises the local variables a, b and c from the
\ data on the data stack. Z goes to c, y to b, and x to a.
\
\ Here is another example:
\ : TEST ( x y z -- z(x+y) )
\   locals{ x y z } set z  set y  set x
\   x y + z * ;
\
\ Where recursion is used with a definition that contains locals, each
\ instance of the definition shall inherit its own set of new locals.
\ These will be automatically de-allocated when the recursion un-winds.
\ Locals consume no dictionary space at all. Their names are temporarily
\ hashed during compilation only. After that their names are not required.
\ The hash table is set to the end of RAM (see dictAddr). There is
\ room for 14 locals per definition as currently set.
\ The locals stack sits immediately above the hash table and grows
\ towards lower memory addresses (the hash table grows to higher addresses).
\
\ During execution, locals add very little overhead: 1 call to allocate
\ the appropriate number of local-stack cells at the beginning of a colon
\ definition, and a similar call to de-allocate at the end of a colon
\ definition.
\ References to locals are compiled as literals representing an offset
\ into the locals stack, plus a call to @local


0 VALUE locals?             \ true if a colon-def has locals
0 VALUE localCount          \ number of locals in a colon def
0 VALUE localOffset
$FFE0 VALUE dictAddr        \ address of start of local dictionary
$A006 @ VALUE _FIND         \ save contents of FIND vector
VARIABLE _LS                \ top of local stack pointer
dictAddr _LS !              \ set local stack pointer

\ note: the locals stack and the locals dictionary grow away from each
\ other. There is a pre-decrement on local stack operations, therefore
\ it is safe to set the locals stack to the same address as the locals
\ dictionary, as they grow away from each other.

\ Assembly language enhancements:
\ Note: the ASM definitions are commented out, so it is not necessary
\       to load the assembler. Instead, CODE equivalents are provided
\       directly following each ASM definition. The ASM definitions
\       are retained in the source code in case changes are required
\       later.
\ asm: (allotLocals) ( -- )
\     \ the value to allot is in-line, pointed to by PC
\     r3 *+ r1 mov,       \ get inline parameter and jump over it
\     r1 1 sla,           \ convert to cells 
\     r1 _LS @@ a,        \ add it to local stack pointer
\ ;asm
HEX 
CODE: (allotLocals) C073 0A11 A801 _LS , ;CODE                                      

\ asm: @local ( -- n )
\     _LS @@ r0 mov,      \ get dictionary pointer
\     r3 *+ r0 a,         \ add inline index
\     sp dect,            \ make space on stack
\     r0 ** *sp mov,      \ read local and place on stack
\ ;asm 
CODE: @local C020 _LS , A033 0644 C510 ;CODE                                 

\ asm: (SET) ( value -- )
\     _LS @@ r0 mov,      \ get locals pointer
\     r3 *+ r0 a,         \ add in-line offset
\     *sp+ r0 ** mov,     \ move value to local
\ ;asm
CODE: (SET) C020 _LS , A033 C434 ;CODE                                      

\ asm: (+SET) ( value -- )
\     _LS @@ r0 mov,      \ get locals pointer
\     r3 *+ r0 a,         \ add in-line offset
\     *sp+ r0 ** a,       \ add value to local
\ ;asm
CODE: (+SET) C020 _LS , A033 A434 ;CODE                                      
DECIMAL

: allotLocals ( n -- ) \ compile run-time code to allot n locals
    COMPILE (allotLocals) , \ n goes inline 
    TRUE TO locals? ;

: >HASH ( c-addr len -- u)
  \ hashes a string using the CRC-16 algorithm
  $FFFF             \ intial CRC16
  -ROT              \ move it out of the way
  OVER + SWAP DO    \ for each byte in the string
    I C@ XOR        \ xor with CRC16
    8 0 DO          \ for 8 bits in the byte
        DUP 1 AND   \ note the LSB prior to shift
        SWAP 1 >>   \ shift the CRC16
        SWAP IF 
            $A001 XOR \ if LSB was 1 then apply polynomial
        THEN  
    LOOP
  LOOP ;

: (LOCAL) ( addr len -- )
    ?DUP IF \ is a local. Add to fleeting locals dictionary:
        >HASH               \ hash the variable name
        dictAddr localCount CELLS + ! \ store hash in local dictionary
        1 +TO localCount    \ increment number of locals
    ELSE \ end of locals list
        DROP
        localCount negate allotLocals
    THEN ;

: LOCALS{ ( "name...name }" -- 
    0 TO localCount
    BEGIN
        BL WORD  OVER C@
        ASCII } - OVER 1 - OR
    WHILE               \ while | character not detected
        (LOCAL)         \ add local variable to locals dictionary
    REPEAT
    2DROP  0 0 (LOCAL)  \ end local dictionary processing
; IMMEDIATE

: compileLocal ( -- )
    COMPILE @local
    localOffset 1- CELLS , ( offset compiled inline ) ;
    
: findLocal ( addr len - offset+1|0)
    \ search locals dictionary for word and return offset into
    \ locals stack+1 if found or 0 if not found
    >HASH 0 SWAP
    localCount 0 DO
        dictAddr I CELLS + @ OVER = IF
            SWAP DROP I 1+ SWAP LEAVE
        THEN
    LOOP  DROP 
    DUP TO localOffset ;

: localNotFound ( --)
    CR ." Error: Local not found."
    FALSE to locals? ABORT ;

: doSET ( xt "local" value -- )
    BL WORD findLocal IF
        , ( xt )
        localOffset 1- CELLS , ( in-line offset )
    ELSE
        localNotFound
    THEN ;
   
: SET  ( "local" value --) \ write the value to the local variable
    ['] (SET) doSet ; IMMEDIATE
    
: +SET ( "local" value --) \ add the value to the local variable
    ['] (+SET) doSet ; IMMEDIATE

: ; locals? IF localCount allotLocals THEN [COMPILE] ; ; IMMEDIATE

0 value _addr   0 value _len
: FIND ( addr len -- cfa flag )
    2DUP  TO _len  TO _addr
    _FIND EXECUTE DUP 0= IF
        STATE @ IF
            locals? IF
                2DROP _addr _len findLocal IF
                    ['] compileLocal 1
                ELSE
                    0 0
                THEN
            THEN
        THEN
    THEN ;

' FIND $A006 ! \ re-vector FIND to use our FIND first


Tests:
------
: test ( a b c -- ) 
  \ compiled size in previous version: 96 bytes
  \     compiled size in this version: 80 bytes (16.6% saving)
  locals{ a b c } set c  set b  set a
  cr ." a=" a .
  cr ." b=" b .
  cr ." c=" c . ;

: test1 
  \ compiled size in previous version: 98 bytes 
  \     compiled size in this version: 78 bytes (20.4% saving)
  locals{ a b c } $BEEF set a  $FACE set b  $B00B set c 
  a $.  b $.  c $. $100 +SET c  c $. ;

  
: test2
  \ compiled size in previous version: 112 bytes 
  \     compiled size in this version: 90 bytes (19.6% saving)
  locals{ tom dick harry }
  100 set tom
  200 set dick
  300 set harry
  1 +set tom
  2 +set dick 
  -9 +set harry
  cr tom . dick . harry . ;
